perm filename ALAID.PAL[AL,HE] blob
sn#373803 filedate 1978-08-08 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00021 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 FILES, SETNAM
C00005 00003 Data structures: Notes, note cells, message buffers
C00009 00004 GETNOTE, SNDNOTE, SERVER
C00013 00005 DOGTBUF, DOUSBUF, DORLBUF
C00015 00006 LINKQUEUE, UNLQUE, SAMEID
C00018 00007 TREATMESSAGE, GETOFS, DOERR, SNDANS
C00025 00008 MAKREQ, SNDREQ
C00029 00009 KTABLE, RTABLE, LOOKUP, RLOOKP, GETOCT, ascie messages
C00038 00010 TACK, SKIPSP, SKIPOPT
C00040 00011 DOGETVAL, DOSETVAL
C00049 00012 DOWAIT, DOSIGNAL
C00054 00013 DOSETNAM
C00058 00014 DOSTART, DODDT, DONOTICE
C00064 00015 DOHALT, DOGO
C00067 00016 DOSHOW, ONESHOW, DOPUT, NUMRFY
C00077 00017 DOBREAK, DOUNBREAK, BRSRCH
C00083 00018 DOJUMP, DOSTEP, ONESTEP
C00087 00019
C00088 00020 Driver for test of communications, ALINIT, ALKILL
C00092 00021 BUGS
C00093 ENDMK
C⊗;
; FILES, SETNAM
.IFNDF ALAID
DEBUG == 1
.IFF
DEBUG == 0
.ENDC
KERNEL == 1
FLOAT == 1
.IFNZ DEBUG
;Set up the necessary mapping for the Zonker
.INSRT ZONKER.PAL[AL,HE]
.OFFSET -160000 ;Put ALAID in the Zonker
.IF1
.TITLE Test of ALAID
.INSRT ALHEAD.PAL[AL,HE]
.INSRT K1DEF.PAL[11,SYS]
.ENDC
. = PATCH
.BLKW 200 ;Patch area
;If DDT sends us to user I space this will start the Kernel up anyway
. = START
RESTRT ;EMT gets us into Kernel I space
RESTRT
RESTRT ;Kernel INIT entry point
. = INTRP
CODE$ == . ;Interpreter code & data spaces start here
DATA$ == .
.INSRT ALIO.PAL[AL,HE]
.INSRT FLOAT.PAL[AL,HE]
STSW LBDEBUG,1 ;1 => first word of any large block is address of maker.
.INSRT LARGEB.PAL[AL,HE]
INSTSZ == 20 ;Size of an interpreter stack
.ENDC
.IFZ DEBUG
CODE
; Special pseudo-ops
SETNAM: ;Interpreter code
MOV @IPC(R4),INTNAM(R4)
BMPIPC ;
CCC ;Clear Condition Code
RTS PC ;Done
.ENDC
; Data structures: Notes, note cells, message buffers
; Notes from 10 to 11:
GETBUF == 1 ;
USEBUF == 2 ;
RELBUF == 3 ;
; Notes from 11 to 10:
BUFALC == 101 ;
TAKBUF == 102 ;
; Offsets in notes:
ARG1 == 2
ARG2 == 4
; Offsets in message buffers:
MESID == 0 ;
MESTYP == 2 ;
FROMTEN == 1 ;
FROMELF == 2 ;
REQUEST == 4 ;
ANSWER == 10 ;
MESLTH == 4 ;
MESBEG == 6 ;
;NOTB10 The notebox from 11 to the 10 (byte address) defined in COMTAB
;NOTB11 The notebox from 10 to the 11 (byte address) defined in COMTAB
NOTSIZ == 3 ; In WORDS!
BUFSIZ == 200 ; In WORDS!
DATA
NXTID: .WORD 0 ;Always even
CURNAM: .WORD 0 ;The current ISB for active interpreter.
ALLIVE: .WORD 0 ;AL interpreter alive if non-zero
; Answer block:
II == 0
XX ANSBUF ;Points to a buffer for the return answer
XX ANPTR ;Initialized to point to the start of the message in ANSBUF
XX AGBUF ;Start of the request buffer
XX AGARG ;Start of the arguments in request buffer
XX AGPTR ;Points to the current place in the request
XX VALPTR ;The value to be used in the answer
XX GPHPTR ;The graph node to be used in the answer
ABKSIZ == II/2 ;Size of an answer block, in words.
; Request block:
II == 0
XX REQBUF ;Place where the request will be assembled
XX REQPTR ;Current end of the assembled request
XX REQRES ;Where the response is placed
XX REQEVT ;The event that will signal the return of the response
XX REQQUE ;The queue node holding our waiting process
RQBSIZ == II/2 ;Size in WORDS.
; Interlock event
ALDEVT: .WORD 0
;HN Halt Switch
HALTSW: .WORD 0 ;HN 0 = Run , 1 = Halt
; Waitqueue structure:
II == 0
XX QNEXT ;Next entry on queue
XX QPREV ;Previous entry on queue
QID == II ;Identifier of this node. Same field as QEVT.
XX QEVT ;The event this waiter is expecting
XX QBUF ;The answer he was waiting for
QUELTH == II/2 ;Length of queue node in WORDS.
WAITQ: .BLKW QUELTH ;List of processes waiting to hear answers.
CODE
; GETNOTE, SNDNOTE, SERVER
COMMENT ⊗ Since there is only one server, it is not necessary to put
any interlocks around code in GETNOTE and SNDNOTE. ⊗
GETNOTE:
COMMENT ⊗ Returns the first note seen in a block pointed to by R0. ⊗
MOV R2,-(SP) ;Save R2
1$: TST NOTB11 ;Anything there?
BNE 2$ ;Yes
SLEEP #100 ;and sleep a while
TST ALLIVE ;See if the main interpreter has gone away
BNE 1$ ;if not try again
DISMIS ;if so we should die
2$: MOV #NOTSIZ,R0 ;
MOV R0,R2 ;R2 ← Count of how many words to transfer
JSR PC,GTFREE ;R0 ← place to store the note
MOV #NOTB11,R1 ;Transfer the note
3$: MOV (R1)+,(R0)+
SOB R2,3$ ;Repeat
SUB #2*NOTSIZ,R0 ;Reset R0 to point to front of note.
CLR NOTB11 ;Clear the note, to say we got it.
MOV (SP)+,R2 ;Restore R2
RTS PC ;Done
SNDNOTE:
COMMENT ⊗ R0 points to a note to send. Send it and then release the
block. ⊗
MOV R2,-(SP) ;Sve R2
1$: TST NOTB10 ;Anything there?
BEQ 2$ ;No.
SLEEP #100 ;Yes, so sleep a while
BR 1$ ;And try again
2$: MOV #NOTSIZ-1,R1 ;R1 ← count of words to send
MOV #NOTB10+2,R2;R2 ← Where to put it.
TST (R0)+ ;Skip the first word; we will put it in last
3$: MOV (R0)+,(R2)+
SOB R1,3$ ;Repeat
SUB #2*NOTSIZ,R0 ;Reset R0 ← LOC[note]
MOV (R0),NOTB10 ;Activate the note by sending the first word
JSR PC,RLFREE ;Release the block.
MOV (SP)+,R2 ;Restore R2
RTS PC ;Done
SERVER:
COMMENT ⊗ Listens for notes from the 10 and acts on them. Never
returns. Uses R2. ⊗
JSR PC,GETNOTE ;R0 ← LOC[note]
MOV (R0),R1 ;R1 ← type of note
MOV R0,R2 ;R2 ← LOC[note]
CMP R1,#GETBUF ;GETBUF
BNE 1$
JSR PC,DOGTBUF ;
BR 4$ ;
1$:
CMP R1,#USEBUF ;USEBUF
BNE 2$
JSR PC,DOUSBUF ;
BR 4$ ;
2$:
CMP R1,#RELBUF ;RELBUF
BNE 3$
JSR PC,DORLBUF ;
BR 4$ ;
3$:
ALERR SRVMES ;Illegal code
4$: MOV R2,R0 ;Release the note.
JSR PC,RLFREE ;
BR SERVER ;One more river, there's one more river to cross.
DATA
SRVMES: ASCIE </CAN'T UNDERSTAND NOTE FROM THE 10/>
CODE
; DOGTBUF, DOUSBUF, DORLBUF
DOGTBUF:
COMMENT ⊗ Called by SERVER. The 10 wants us to allocate a buffer.
R0 = LOC[note]. The size in bytes is in ARG1(R0). We should respond
with BUFALC <size> <adr>. ⊗
MOV ARG1(R0),R0 ;R0 ← size argument
MOV R0,-(SP) ;Save size argument
JSR PC,GTFREE ;Get the buffer out of free storage
MOV R0,-(SP) ;Save buffer address
MOV #NOTSIZ,R0 ;
JSR PC,GTFREE ;R0 ← LOC[new note to send]
MOV #BUFALC,(R0) ;BUFALC
MOV (SP)+,ARG2(R0) ; <adr>
MOV (SP)+,ARG1(R0) ; <size>
JSR PC,SNDNOTE ;Send the note off. (He will destroy it)
RTS PC ;Done
DOUSBUF:
COMMENT ⊗ Called by SERVER. R0 = LOC[note]. The buffer that starts
at address ARG1(R0) is a message. Look at it, act on it, and then
recycle the message buffer. ⊗
MOV ARG1(R0),R0 ;R0 ← LOC[message]
JSR PC,TREATMESSAGE ;Treat it and release it
RTS PC ;Done
DORLBUF:
COMMENT ⊗ Called by SERVER. R0 = LOC[note]. The buffer that starts
at ARG1(R0) has been used by the 10, and we may deallocate it now. ⊗
MOV ARG1(R0),R0 ;R0 ← LOC[expended message]
JSR PC,RLFREE ;
RTS PC ;Done
; LINKQUEUE, UNLQUE, SAMEID
LINKQUEUE:
COMMENT ⊗ There is a dummy queue at the start of the chain. R1
points to the queue header, and R0 is the one we wish to add in.
Exclusion should be on before this routine is called; it remains
on afterwards. ⊗
MOV QNEXT(R1),QNEXT(R0)
MOV R1,QPREV(R0)
MOV R0,QNEXT(R1)
RTS PC
UNLQUE:
COMMENT ⊗ R0 points to a queue node. It is unlinked from its queue.
R0 is left pointing at the same node. Exclusion should be on before
this routine is called; it will remain on afterwards. ⊗
MOV QPREV(R0),R1 ;R1 ← prev(old)
MOV QNEXT(R0),QNEXT(R1) ;Transfer forward link.
MOV QNEXT(R0),R1 ;R1 ← next(old)
BEQ 1$ ;If any
MOV QPREV(R0),QPREV(R1) ;Transfer backward link.
1$: RTS PC ;Done.
SAMEID:
COMMENT ⊗ R0 = header of queue. R1 = ID to look for. If there is a
node in the queue with that ID, it is returned in R0. Otherwise, R0
← 0. Exclusion should be on before this routine is called; it will
remain on afterwards. ⊗
1$: MOV QNEXT(R0),R0 ;R0 ← next (real) node in queue
BEQ 2$ ;If any.
CMP QID(R0),R1 ;Match the ID?
BNE 1$ ;No. Try next one.
JSR PC,UNLQUE ;R0 ← same node, now unlinked.
2$: RTS PC ;Done
; TREATMESSAGE, GETOFS, DOERR, SNDANS
TREATMESSAGE:
COMMENT ⊗ R0 = LOC[buffer from the 10]. Print out its contents and
treat it. ⊗
MOV R2,-(SP) ;Save R2
MOV R0,R2 ;R2 ← LOC[buffer]
;print the message
.IFZ DEBUG
EVWAIT CSLEVT ;
.ENDC
MOV #CRLFX,R0 ;
JSR PC,TYPSTR ;
MOV R2,R0 ;
ADD #MESBEG,R0 ;R0 ← LOC[start of message itself]
JSR PC,TYPSTR ;Print it
.IFZ DEBUG
EVSIG CSLEVT ;
.ENDC
;see what kind of message it is
MOV R2,R0 ;
MOV MESTYP(R0),R1 ;R1 ← MESTYPE;
BIT #ANSWER,R1 ;An answer?
BEQ 2$ ;No
;got a response. See if anyone is waiting to hear it.
MOV MESID(R0),R1;R1 ← MESID
EVWAIT ALDEVT ;Enter critical section
MOV #WAITQ,R0 ;R0 ← head of wait.
JSR PC,SAMEID ;R0 ← queue node waiting for this MESID.
EVSIG ALDEVT ;End of critical section
TST R0 ;Was there a waiting process?
BNE 1$ ;Yes.
ALERR TRTMMS ;None found. A bug!
1$: MOV R2,QBUF(R0) ;Give him his result.
EVSIG QEVT(R0) ;Give him his signal
BR 3$ ;Prepare to leave
;got a question. Get someone to look at it.
2$: JSR PC,RLOOKP ;Start up a process to fulfill the request and
;delete the message
3$: MOV (SP)+,R2 ;Restore R2
RTS PC ;
DATA
TRTMMS: ASCIE </GOT UNEXPECTED ANSWER FROM THE 10./>
CODE
GETOFS:
COMMENT ⊗ R2 = LOC[answer block]. We want to see (OFFSET n). If we
do, we put LOC[graph node for n] in GPHPTR(R2); otherwise R0 ← 0. R2 is
still LOC[answer block], but ARGPTR is properly updated. ⊗
MOV AGARG(R2),R0;R0 ← LOC[argument string]
CMPB (R0)+,#'( ;A left paren?
BNE 1$ ;No.
JSR PC,LOOKUP ;R0 ← next thing on arg, R1 ← OFSCOD, we hope.
CMP R1,#OFSCOD ;Was it offset?
BNE 1$ ;No.
JSR PC,GETOCT ;R0 ← after the arg, R1 ← octal number found.
MOV R0,AGPTR(R2);Save arg. ptr
MOV R1,R0 ;R0 ← integer offset
MOV CURNAM,R4 ;R4 ← LOC[ISB of active interpreter]
JSR PC,GETARG ;R0 ← LOC[environment entry for variable]
MOV R0,GPHPTR(R2)
BEQ 1$ ;If anyone home. Else will return failure.
MOV AGPTR(R2),R0;
JSR PC,SKIPSP ;Skip spaces.
MOV #'),R1 ;
JSR PC,SKIPOP ;Skip the ), if it is there.
MOV R0,AGPTR(R2);
RTS PC ;
1$: CLR R0 ;Failure return
RTS PC ;
DOERR:
COMMENT ⊗ There has been an error in parsing some command. R2 =
LOC[answer block]. We will say "ERROR (message)". R2 will be left
with ANPTR fixed up. ⊗
MOV ANPTR(R2),R0;R0 ← answer pointer
MOV #ERRMES,R1 ;
JSR PC,TACK ;Tack on "ERROR "
MOV #LPAREN,R1 ;
JSR PC,TACK ;Tack on " ( "
MOV AGBUF(R2),R1;
ADD #MESBEG,R1 ;
JSR PC,TACK ;Tack on the original message
MOV #RPAREN,R1 ;
JSR PC,TACK ;Tack on " ) "
MOV R0,ANPTR(R2);
JMP SNDANS ;He will never return.
SNDANS:
COMMENT ⊗ R2 = LOC[answer block]. ANPTR(R2) = end of the message.
ANSBUF(R2) = front of the message. Compute the message length, send
the message out, reclaim the answer block, including the AGBUF, and
then reclaim the interpreter stack, the PDB of this process and
dismiss. ⊗
;compute MESLTH
MOV ANPTR(R2),R1;R1 ← ans. ptr
MOV ANSBUF(R2),R0 ;R0 ← LOC[answer buffer]
SUB R0,R1 ;R1 ← length in bytes of message
ASR R1 ;in words
BCC 1$ ;HN OK if even numbers of bytes
INC R1 ;HN otherwise add 1 to the length in words
INC ANPTR(R2) ;HN reflct on the ans. ptr
MOVB #' ,@ANPTR(R2) ;HN and put a blank byte at the end of the mess.
1$: MOV R1,MESLTH(R0); MESLTH
;send the result back. R0 = LOC[message]
MOV #NOTSIZ,R0 ;
JSR PC,GTFREE ;R0 ← LOC[new note to send]
MOV #TAKBUF,(R0);TAKBUF
MOV (SP),R1 ;R1 ← LOC[answer block]
MOV ANSBUF(R2),ARG1(R0) ; <adr>
JSR PC,SNDNOTE ;Send the note off. (He will destroy it)
;reclaim answer block
MOV R2,R0 ;Reclaim the argument message buffer
MOV AGBUF(R0),R0;
JSR PC,RLFREE ;
MOV R2,R0 ;Reclaim the answer block itself
JSR PC,RLFREE ;
;reclaim interpreter stack
MOV R3,R0
SUB #2*INSTSZ,R0
JSR PC,RLFREE
;reclaim Processor Desriptor Block
MOV R5,R0 ;
JSR PC,RLFREE ;
DISMIS ;Gone!
; MAKREQ, SNDREQ
MAKREQ:
COMMENT ⊗ Returns in R3 a pointer to a brand new request block, with
REQBUF and REQPTR initialized to a new area for assembling a request.
The REQBUF is initialized with MESTYP. ⊗
MOV #RQBSIZ,R0 ;Get a request block
JSR PC,GTFREE ;
MOV R0,R3 ;R3 ← LOC[request block]
MOV #BUFSIZ,R0 ;
JSR PC,GTFREE ;R0 ← LOC[request buffer]
MOV #FROMELF+REQUEST,MESTYP(R0)
MOV R0,REQBUF(R3)
ADD #MESBEG,R0 ;
MOV R0,REQPTR(R3)
RTS PC ;
SNDREQ:
COMMENT ⊗ R3 = LOC[request block]. REQPTR(R3) = end of the message.
REQBUF(R3) = front of the message. Compute the message length, send
the message out, wait for a reply, and then put the response in
REQRES(R3). R3 is left pointing to the request block. ⊗
;compute MESLTH
MOV REQPTR(R3),R1 ;R1 ← ans. ptr
MOV REQBUF(R3),R0 ;R0 ← LOC[request buffer]
SUB R0,R1 ;R1 ← length in bytes of message
ASR R1 ;in words
MOV R1,MESLTH(R0); MESLTH
MOV REQBUF(R3),R0 ;R0 ← LOC[message buffer]
EVMAK ;Get an event that will signal the response to the request.
MOV (SP),MESID(R0) ;That will be the MESID.
MOV (SP)+,REQEVT(R3) ;REQEVT
MOV #QUELTH,R0 ;Enqueue ourselves for the response
JSR PC,GTFREE ;R0 ← LOC[queue node]
MOV R0,REQQUE(R3) ;REQQUE
MOV REQEVT(R3),QEVT(R0) ;QEVT
EVWAIT ALDEVT ;Enter critical region
MOV #WAITQ,R1 ;
JSR PC,LINKQUEUE;
EVSIG ALDEVT ;Leave critical region
;send the request out. R0 = LOC[message]
MOV #NOTSIZ,R0 ;
JSR PC,GTFREE ;R0 ← LOC[new note to send]
MOV #TAKBUF,(R0);TAKBUF
MOV REQBUF(R3),ARG1(R0) ; <adr>
JSR PC,SNDNOTE ;Send the note off. (He will destroy it)
EVWAIT REQEVT(R3) ;Wait for the event to happen
COMMENT ⊗ When the answer comes, the server will unlink the
queue for us. We must destroy the event and reclaim the
queue node ourselves. ⊗
;the response has come, and the answer is in QBUF(REQQUE(R3))
EVKIL REQEVT(R3) ;
MOV REQQUE(R3),R0 ;
MOV QBUF(R0),REQRES(R3) ;REQRES
JSR PC,RLFREE ;Release the queue node
RTS PC ;
; KTABLE, RTABLE, LOOKUP, RLOOKP, GETOCT, ascie messages
DATA
LPAREN: .ASCIZ / ( /
RPAREN: .ASCIZ / ) /
DONEMES:.ASCIZ /DONE /
ERRMES: .ASCIZ /ERROR /
YTHMES: .ASCIZ /YOUTHERE /
CRLFMS: .ASCIZ /
/ ;HN
HLTMSG: .ASCIZ /ALL ACTIVE INTERPRETERS HALTED/ ;HN
ADRMES: .ASCIZ /ADDRESS: / ;HN
PCDMES: .ASCIZ / P_CODE:/ ;HN
OVRMES: .ASCIZ /SORRY ... BREAK TABLE OVERFLOW/ ;HN
NOBRKPT:.ASCIZ /NO BREAKPOINT AT THAT ADDRESS/ ;HN
SAMEBR: .ASCIZ /THERE IS ALREADY A BREAKPOINT THERE !/ ;HN
SETHLT: .ASCIZ /PLEASE FIRST "HALT" / ;HN
ASTRSK: .ASCIZ /*/ ;HN
COMSPC: .ASCIZ /, / ;HN
.EVEN
.MACRO KWORD KNAME, KINFO
II == .
ASCIE /KNAME/
. = II + 6 ;Truncate to 6 characters
KINFO ;Either code for this keyword, or service routine address
.ENDM
OFSCOD == 1
SCACOD == 2
VCTCOD == 3
TRACOD == 4
PLCCOD == 5
KTABLE: ;List of keywords.
KWORD <OFFSET>, OFSCOD
KWORD <SCALAR>, SCACOD
KWORD <VECTOR>, VCTCOD
KWORD <TRANS >, TRACOD
KWORD <PLACE >, PLCCOD
KTEND: .WORD 0
RTABLE: ;List of requests.
KWORD <GETVAL>, DOGETVAL
KWORD <SETVAL>, DOSETVAL
KWORD <SIGNAL>, DOSIGNAL
KWORD <WAIT >, DOWAIT
KWORD <SETNAM>, DOSETNAM
KWORD <START >, DOSTART
KWORD <DDT >, DODDT
KWORD <NOTICE>, DONOTICE
KWORD <HALT >, DOHALT ;HN
KWORD <SHOW >, DOSHOW ;HN
KWORD <PUT >, DOPUT ;HN
KWORD <BREAK >, DOBREAK ;HN
KWORD <UNBRK >, DOUNBREAK ;HN
KWORD <JUMP >, DOJUMP ;HN
KWORD <GO >, DOGO ;HN
KWORD <STEP >, DOSTEP ;HN
RTEND: .WORD 0
CODE
COMMENT ⊗ R0 = LOC[string]. Find which keyword heads the string,
using a disgusting linear search, and return R1 ← 0 if no keyword
found, otherwise R1 ← code for that keyword. R0 ← next entry on
string. ⊗
LOOKUP:
MOV R2,-(SP) ;Save R2
MOV #KTABLE,R1 ;R1 ← LOC[current try in KTABLE]
1$: MOV #6,R2 ;R2 ← count of how many characters to match.
2$: CMPB (R0)+,(R1)+;Match the next letter?
BEQ 4$ ;Yes
3$: ADD R2,R0 ;
SUB #7,R0 ;R0 ← start of given string.
ADD R2,R1 ;R1 ← end of test string
TSTB (R1)+ ;R1 ← start of next test string
CMP R1,#KTEND ;Off the end?
BLO 1$ ;No.
BR 6$ ;Yes.
4$: SOB R2,2$ ;Try the next, if any.
;found a match. R1 = LOC[KINFO]
JSR PC,SKIPSP ;Skip spaces (does not hurt R1)
MOV (R1),R1 ;R1 ← KINFO
5$: MOV (SP)+,R2 ;Restore R2
RTS PC ;Done
6$: CLR R1 ;Did not find anything
BR 5$ ;
COMMENT ⊗ R0 = LOC[message buffer request]. Find which request word
heads the string, using a disgusting linear search, and start a
process to handle the request. He will see to the deletion of the
message buffer. ⊗
RLOOKP:
MOV R2,-(SP) ;Save R2
MOV R0,-(SP) ;Save LOC[message buffer request]
ADD #MESBEG,R0 ;R0 ← LOC[request string]
MOV #RTABLE,R1 ;R1 ← LOC[current try in KTABLE]
1$: MOV #6,R2 ;R2 ← count of how many characters to match.
2$: CMPB (R0)+,(R1)+;Match the next letter?
BEQ 4$ ;Yes
3$: ADD R2,R0 ;
SUB #7,R0 ;R0 ← start of given string.
ADD R2,R1 ;R1 ← end of test string
TSTB (R1)+ ;R1 ← start of next test string
CMP R1,#RTEND ;Off the end?
BLO 1$ ;No.
MOV #DOERR,R2 ;So what we will do is handle the error.
BR 5$
4$: SOB R2,2$ ;Try the next, if any.
;found a match. R1 = LOC[KINFO]
MOV (R1),R2 ;R2 ← KINFO = address of service routine
5$: JSR PC,SKIPSP ;Skip spaces
MOV R0,-(SP) ;Save AGPTR
;build the answer block
MOV #BUFSIZ,R0
JSR PC,GTFREE ;R0 ← LOC[answer buffer]
MOV 2(SP),R1 ;R1 ← AGBUF
MOV MESID(R1),MESID(R0) ;Transfer the MESID to answer from request.
MOV #FROMELF+ANSWER,MESTYP(R0) ;MESTYP
MOV R0,-(SP) ;Save ANSBUF
MOV #ABKSIZ,R0 ;Get an answer block
JSR PC,GTFREE ;R0 ← LOC[answer block]
MOV (SP)+,R1 ;R1 ← ANSBUF
MOV R1,ANSBUF(R0)
ADD #MESBEG,R1 ;
MOV R1,ANPTR(R0);
MOV (SP),AGARG(R0)
MOV (SP)+,AGPTR(R0)
MOV (SP)+,AGBUF(R0)
MOV R0,-(SP) ;Save LOC[answer block]
;set up a new process with R2 ← LOC[answer block] to fulfil request.
INSTSZ == 20 ;Size of an interpreter stack
MOV #INSTSZ,R0 ;R3 stack space
JSR PC,GTFREE ;
ADD #2*INSTSZ,R0 ;to end of space
MOV R0,-(SP) ;Save stack space
MOV #210,R0 ;Room for process descriptor
JSR PC,GTFREE ;R0 ← LOC[new process descriptor]
MOV #UFPUSE+UGRSAV+4,PDBSTA(R0);Use floating point, use saved registers.
MOV R0,USKMIN(R0) ;Set up min pointer for SP
ADD #UFEC+36,USKMIN(R0)
MOV R0,USKMAX(R0) ;Set up max pointer for SP
ADD #420,USKMAX(R0)
MOV #144100,UPSW(R0) ;Set up psw
MOV (SP)+,PDBR3(R0) ;Store away the R3 stack pointer.
MOV (SP)+,PDBR2(R0) ;Store away the R2 = LOC[answer block]
MOV CURNAM,PDBR4(R0) ;Start out on the current ISB
MOV R0,PDBR5(R0) ;Store away the R5 = PDB address.
MOV #USRIM,UIMAP(R0) ;Map instruction space
FORK R0,R2,#USRDM ;Cause the new process to be started
6$: MOV (SP)+,R2 ;Restore R2
RTS PC ;Done
GETOCT:
COMMENT ⊗ R0 = string pointer. Finds an octal number, skipping
spaces to do so, and places its value in R1. Leaves R0 at end of
spaces following the string. ⊗
MOV R2,-(SP) ;Save R2
CLR R1 ;R1 is the eventual result
JSR PC,SKIPSP ;Skip leading spaces
1$: MOVB (R0)+,R2 ;R2 ← Character
CMP #'0,R2 ;Too small?
BGT 2$ ;yes
CMP #'7,R2 ;Too large?
BGE 3$ ;no
2$: TSTB -(R0) ;Move back one place
JSR PC,SKIPSP ;skip trailing spaces
MOV (SP)+,R2 ;Restore R2
RTS PC ;Done
3$: MOV R2,-(SP) ;Save the character
ASH #3,R1 ;Compute new result
BIC #60,(SP) ;
ADD (SP)+,R1 ;
BR 1$ ;And repeat
TACK, SKIPSP, SKIPOPT
TACK:
COMMENT ⊗ R1 = LOC[ascie string to tack on], R0 = LOC[where to put
it]. Returns R0 ← next location available in destination string. ⊗
MOVB (R1)+,(R0)+;Copy a byte
BNE TACK ;Repeat while necessary
DEC R0 ;Go back past the null
RTS PC ;Done
SKIPSP:
COMMENT ⊗ R0 = LOC[string]. Skip past any spaces, returning R0 ← LOC[next
non-space element of the string. Leaves R1 unchanged. ⊗
CMPB (R0)+,#' ;
BEQ SKIPSP ;
DEC R0 ;Go back past the non-space
RTS PC ;
SKIPOPT:
COMMENT ⊗ R0 = LOC[string]. Skip past the character in R1, if it is
the next character, and in any case, skip past any spaces. ⊗
CMPB (R0),R1 ;The optional character?
BNE 1$ ;No
TSTB (R0)+ ;Yes. Skip it.
1$: JMP SKIPSP ;Skip over spaces, and let SKIPSP return.
; DOGETVAL, DOSETVAL
COMMENT ⊗ All service routines are instantiated as processes, where
R2 points at an answer block, with ANPTR, ANSBUF, AGBUF, AGPTR, AGARG
all set up. The ANSBUF already has MESID and MESTYP set. R3 points
at an interpreter stack, if it should be needed, and R5 points at the
PDB, for reclamation purposes. Service routines dismiss when they
are finished, having destroyed their PDB. ⊗
DOGETVAL: ;Service routine
COMMENT ⊗ Currently accepted argument string is: (OFFSET n). The
OFFSET construct will cause that variable in the current interpreter
to have its value produced. The answer is of the form "ISVAL arg
val", unless something goes wrong, in which case the answer will be
"ERROR (GETVAL arg)". ⊗
;scan the arguments
JSR PC,GETOFS ;GPHPTR(R2) ← LOC[environment entry for offset]
TST R0 ;or was there an error?
BEQ 3$ ;oops.
MOV GPHPTR(R2),R0 ;R0 ← LOC[Env entry]
TSTB 1(R0) ;Check accessing method
BNE 1$
MOV 2(R0),VALPTR(R2) ;Direct access - store away LOC[value]
BR 2$
1$: CALL GETVAL,<2(R0)> ;Indirect access - R0 ← LOC[value]
MOV R0,VALPTR(R2) ;
2$: MOV AGPTR(R2),R0;
TSTB (R0) ;At the end?
BNE 3$ ;No. extra arguments.
;prepare the answer. Note that TACK and TACKVAL take a string pointer
; in R0 and leave it right afterwords.
MOV ANPTR(R2),R0 ;R0 ← answer pointer
MOV VALPTR(R2),R1 ;R0 ← LOC[value]
JSR PC,TACKVAL ;Tack it on
MOV R0,ANPTR(R2);
BR 4$ ;Ready to send it back
;In this case, cannot make sense of the argument.
3$: JMP DOERR ;
4$: ;ANPTR(R2) = end of the message. ANSBUF(R2) = front of the message
JMP SNDANS ;Send it winging on its way. Reclaim the answer block.
;Reclaim the PDB. Dismiss.
DOSETVAL:
COMMENT ⊗ Currently accepted argument string is: (OFFSET n) (SCALAR
n.n), (VECTOR n n n), or (TRANS n n ... n). The variable specified
by the first argument has its value changed to the value given by the
second argument. The answer is of the form "DONE", unless something
goes wrong, in which case the answer will be "ERROR (SETVAL args)".
⊗
;scan the arguments
JSR PC,GETOFS ;GPHPTR(R2) ← LOC[environment entry for offset]
TST R0 ;or was there an error?
BEQ 7$ ;oops.
CMPB (R0)+,#'( ;A left paren?
BNE 7$ ;No.
JSR PC,LOOKUP ;R0 ← next thing on arg, R1 ← SCLCOD, we hope.
CMP R1,#SCACOD ;Was it SCALAR?
BNE 1$ ;No.
JSR PC,RELSCN ;R0 ← after the arg, R1 ← 0 <=> number, AC0 ← float rep.
MOV R0,AGPTR(R2);Save arg. ptr
TST R1 ;Number?
BNE 7$ ;No
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[scalar cell]
MOV (R3)+,VALPTR(R2)
STF AC0,(R0) ;Put 'er in.
BR 5$
1$: CMP R1,#VCTCOD ;Was it VECTOR?
BNE 3$ ;No.
MOV R0,AGPTR(R2);Save arg. ptr
JSR PC,GETVEC ;R0 ← -(R3) ← LOC[trans cell]
MOV (R3)+,VALPTR(R2)
MOV R3,-(SP) ;Save R3
MOV R4,-(SP) ;Save R4
MOV R0,R4 ;R4 ← LOC[vector cell]
MOV #3,R3 ;R3 ← count of how many places in VECTOR to fill.
MOV AGPTR(R2),R0;
2$: JSR PC,RELSCN ;R0 ← after the arg, R1 ← 0 <=> number, AC0 ← float rep.
TST R1 ;Number?
BNE 6$ ;No
STF AC0,(R4)+ ;Put 'er in.
SOB R3,2$ ;Repeat
MOV ONE,(R4)+ ;Set weight to one
MOV R0,AGPTR(R2);
MOV (SP)+,R4 ;Restore R4
MOV (SP)+,R3 ;Restore R3
BR 5$
3$: CMP R1,#TRACOD ;Was it TRANS?
BNE 7$ ;No.
MOV R0,AGPTR(R2);Save arg. ptr
JSR PC,GETTRN ;R0 ← -(R3) ← LOC[trans cell]
MOV (R3)+,VALPTR(R2)
MOV R3,-(SP) ;Save R3
MOV R4,-(SP) ;Save R4
MOV R0,R4 ;R4 ← LOC[trans cell]
MOV #14,R3 ;R3 ← count of how many places in TRANS to fill.
MOV AGPTR(R2),R0;
4$: JSR PC,RELSCN ;R0 ← after the arg, R1 ← 0 <=> number, AC0 ← float rep.
TST R1 ;Number?
BNE 6$ ;No
STF AC0,(R4)+ ;Put 'er in.
SOB R3,4$ ;Repeat
MOV R0,AGPTR(R2);
MOV (SP)+,R4 ;Restore R4
MOV (SP)+,R3 ;Restore R3
5$: MOV GPHPTR(R2),R1 ;R1 ← LOC[environment entry]
TSTB 1(R1) ;Check if direct access
BNE 10$ ; nope
MOV VALPTR(R2),2(R1) ; Yes - store value pointer in environment
BR 11$
10$: CALL CHANGE,<2(R1),VALPTR(R2)>
11$: MOV AGPTR(R2),R0;R0 ← arg. ptr.
JSR PC,SKIPSP ;Scan past spaces
MOVB #'),R1 ;
JSR PC,SKIPOPT ;Skip right paren, if any, plus spaces
TSTB (R0) ;At the end?
BNE 7$ ;No. extra arguments.
;prepare the answer. Note that TACK and TACKVAL take a string pointer
; in R0 and leave it right afterwords.
MOV ANPTR(R2),R0 ;R0 ← answer pointer
MOV #DONEMES,R1 ;
JSR PC,TACK ;Tack on "DONE "
MOV R0,ANPTR(R2);
BR 8$ ;Ready to send it back
;in this case, trying to scan a number and failed.
6$: MOV (SP)+,R4 ;Restore R4
MOV (SP)+,R3 ;Restore R3
;In this case, cannot make sense of the argument.
7$: JMP DOERR ;
8$: ;ANPTR(R2) = end of the message. ANSBUF(R2) = front of the message
JMP SNDANS ;Send it winging on its way. Reclaim the answer block.
;Reclaim the PDB. Dismiss.
; DOWAIT, DOSIGNAL;
DOSIGNAL: ;Service routine
COMMENT ⊗ Currently accepted argument string is: (OFFSET n). The
OFFSET construct will cause that variable in the current interpreter
to be signaled. The answer is of the form "DONE", unless something
goes wrong, in which case the answer will be "ERROR (SIGNAL arg)". ⊗
;scan the arguments
JSR PC,GETOFS ;GPHPTR(R2) ← LOC[environment entry for event]
TST R0 ;or was there an error?
BEQ 1$ ;oops.
MOV GPHPTR(R2),R0
EVSIG 2(R0) ;Signal the event.
MOV AGPTR(R2),R0;
TSTB (R0) ;At the end?
BNE 1$ ;No. extra arguments.
;prepare the answer. Note that TACK and TACKVAL take a string pointer
; in R0 and leave it right afterwords.
MOV ANPTR(R2),R0 ;R0 ← answer pointer
MOV #DONEMES,R1 ;
JSR PC,TACK ;Tack on "DONE "
MOV R0,ANPTR(R2);
BR 2$ ;Ready to send it back.
;In this case, cannot make sense of the argument.
1$: JMP DOERR ;
2$: ;ANPTR(R2) = end of the message. ANSBUF(R2) = front of the message
JMP SNDANS ;Send it winging on its way. Reclaim the answer block.
;Reclaim the PDB. Dismiss.
DOWAIT: ;Service routine
COMMENT ⊗ Currently accepted argument string is: (OFFSET n). The
OFFSET construct will cause that variable in the current interpreter
to be waited. The answer is of the form "DONE" when the wait is up,
unless something goes wrong, in which case the answer will be "ERROR
(WAIT arg)". ⊗
;scan the arguments
JSR PC,GETOFS ;GPHPTR(R2) ← LOC[environment entry for event]
TST R0 ;or was there an error?
BEQ 1$ ;oops.
MOV GPHPTR(R2),R0
EVWAIT 2(R0) ;WAIT for the event.
MOV AGPTR(R2),R0;
TSTB (R0) ;At the end?
BNE 1$ ;No. extra arguments.
;prepare the answer. Note that TACK and TACKVAL take a string pointer
; in R0 and leave it right afterwords.
MOV ANPTR(R2),R0 ;R0 ← answer pointer
MOV #DONEMES,R1 ;
JSR PC,TACK ;Tack on "DONE "
MOV R0,ANPTR(R2);
BR 2$ ;Ready to send it back.
;In this case, cannot make sense of the argument.
1$: JMP DOERR ;
2$: ;ANPTR(R2) = end of the message. ANSBUF(R2) = front of the message
JMP SNDANS ;Send it winging on its way. Reclaim the answer block.
;Reclaim the PDB. Dismiss.
; DOSETNAM
DOSETNAM: ;Service routine
COMMENT ⊗ Currently accepted argument string is: "n". the
interpreter with that name will be selected, and its ISB placed in
R4. The answer is of the form "DONE" when the wait is up, unless
something goes wrong, in which case the answer will be "ERROR (SETNAM
arg)". ⊗
;scan the arguments
MOV AGPTR(R2),R0;
JSR PC,GETOCT ;R0 ← after the arg, R1 ← octal number seen
MOV R0,AGPTR(R2);Save arg. ptr
MOV R1,-(SP) ;Stack interpreter name
EVWAIT INTEVT ;Enter critical section
MOV #ISTBLK,R0 ;Find the right interpreter.
1$: MOV R0,R1 ;
MOV NXTINT(R1),R0;
BEQ 2$ ;No such interpreter.
CMP INTNAM(R0),(SP) ;Have we found ours yet?
BNE 1$ ;No. Try again.
EVSIG INTEVT ;End of critical section
TST (SP)+ ;Get rid of the interpreter name.
MOV R0,CURNAM ;CURNAM ← ISB of new interpreter
MOV AGPTR(R2),R0;
TSTB (R0) ;At the end?
BNE 3$ ;No. extra arguments.
;prepare the answer. Note that TACK and TACKVAL take a string pointer
; in R0 and leave it right afterwords.
MOV ANPTR(R2),R0 ;R0 ← answer pointer
MOV #DONEMES,R1 ;
JSR PC,TACK ;Tack on "DONE "
BR 4$ ;Ready to send it back.
;No such interpreter
2$: EVSIG INTEVT ;End of critical secton
;In this case, cannot make sense of the argument.
3$: JMP DOERR ;
4$: ;ANPTR(R2) = end of the message. ANSBUF(R2) = front of the message
JMP SNDANS ;Send it winging on its way. Reclaim the answer block.
;Reclaim the PDB. Dismiss.
; DOSTART, DODDT, DONOTICE
DOSTART: ;Service routine
COMMENT ⊗ Currently accepted argument string is: (PLACE n), which is
optional. A new interpreter is started up, either at n or at PCODE,
if the argument is missing. This new interpreter becomes the
selected interpreter. The answer is of the form "DONE", unless
something goes wrong, in which case the answer will be "ERROR (START
arg)". ⊗
;scan the arguments
MOV AGPTR(R2),R0;
TSTB (R0)+,#'( ;An argument?
BEQ 1$
JSR PC,LOOKUP ;
CMP R1,#PLCCOD ;A place?
BNE 3$ ;No. Illegal argument
JSR PC,GETOCT ;R0 ← after the arg, R1 ← number seen.
MOV R0,AGPTR(R2);Save arg. ptr
MOV R1,R0 ;R0 ← interpreter start address
BR 2$
1$: MOV #PCODE,R0 ;R0 ← interpreter start address
2$: CLR R1 ;No particular event when he is finished.
JSR PC,SPAWN ;R0 ← PDB[new interpreter process].
MOV PDBR4(R0),CURNAM ;Set current interpreter to this one.
CLR HALTSW ;HN Make sure the Halt Switch is turned off !
SCHEDU R0,#INTERP,#USRDM,#2 ;Cause the new process to be started, suspended
;prepare the answer. Note that TACK and TACKVAL take a string pointer
; in R0 and leave it right afterwords.
MOV ANPTR(R2),R0 ;R0 ← answer pointer
MOV #DONEMES,R1 ;
JSR PC,TACK ;Tack on "DONE "
MOV R0,ANPTR(R2);
BR 4$ ;Ready to send it back.
;In this case, cannot make sense of the argument.
3$: JMP DOERR
4$: ;ANPTR(R2) = end of the message. ANSBUF(R2) = front of the message
JMP SNDANS ;Send it winging on its way. Reclaim the answer block.
;Reclaim the PDB. Dismiss.
DODDT: ;Service routine
COMMENT ⊗ Jump to DDT, so that ↑P will proceed. The answer is of the
form "DONE", unless something goes wrong, in which case the answer
will be "ERROR (DDT arg)". ⊗
ALERR DODDTMES ;Here we go to DDT.
;test stuff. Current test: Try the turn-around question YOUTHERE
;at the ten.
MOV R3,-(SP) ;Save R3
JSR PC,MAKREQ ;R3 ← request block.
MOV REQPTR(R3),R0 ;R0 ← REQPTR
MOV #YTHMES,R1 ;Tack on "YOUTHERE"
JSR PC,TACK ;
MOV R0,REQPTR(R3)
JSR PC,SNDREQ ;Send the request on its way, and eventually come back
;with response in the REQRES(R3)
MOV REQRES(R3),R0 ;
ADD #MESBEG,R0 ;Print out the response
JSR PC,TYPSTR ;
MOV REQRES(R3),R0 ;Reclaim the response buffer
JSR PC,RLFREE ;
MOV R3,R0 ;Reclaim request block
JSR PC,RLFREE ;
MOV (SP)+,R3 ;Restore R3
;prepare the answer. Note that TACK and TACKVAL take a string pointer
; in R0 and leave it right afterwords.
MOV ANPTR(R2),R0 ;R0 ← answer pointer
MOV #DONEMES,R1 ;
JSR PC,TACK ;Tack on "DONE "
;ANPTR(R2) = end of the message. ANSBUF(R2) = front of the message
JMP SNDANS ;Send it winging on its way. Reclaim the answer block.
;Reclaim the PDB. Dismiss.
DATA
DODDTMES: ASCIE </SWITCHING TO DDT/>
CODE
DONOTICE: ;Service routine
COMMENT ⊗ The assumption is that someone has moved the arm. Call
MOVED to invalidate all devices and cause good values to be
generated. Return a response of the form "DONE", unless something
goes wrong, in which case the answer will be "ERROR (NOTICE)", which
really ought not to happen. ⊗
JSR PC,NOTICE ;Do the updating.
;prepare the answer. Note that TACK and TACKVAL take a string pointer
; in R0 and leave it right afterwords.
MOV ANPTR(R2),R0;R0 ← answer pointer
MOV #DONEMES,R1 ;
JSR PC,TACK ;Tack on "DONE "
;ANPTR(R2) = end of the message. ANSBUF(R2) = front of the message
JMP SNDANS ;Send it winging on its way. Reclaim the answer block.
;Reclaim the PDB. Dismiss.
; DOHALT, DOGO
DOHALT: ;HN
COMMENT ⊗ Test service routine for HALT.
Announce the HALT event for the interpreters and the user. ⊗
MOV #1,HALTSW ;HN Set the halt switch
MOV ANPTR(R2),R0 ;HN R0 ← answer pointer
MOV #HLTMSG,R1 ;HN message to the user
JSR PC,TACK ;HN Tack on "ALL INTERPRETERS HALTED"
MOV R0,ANPTR(R2);HN
JMP SNDANS ;HN send it,reclaim as RF says ..., and dismis.
DOGO:
COMMENT ⊗ Test service routine
Causes all WAKEVT's to be signalled. ⊗
MOV CURNAM,R4 ;HN
MOV IPC(R4),R1 ;HN
CMP (R1),#XBRACE;HN
BNE 11$ ;HN
JSR PC,BRSRCH ;HN Search the breakpoint table
TST R0 ;HN Found ?
BEQ 5$ ;HN No.
ADD #2,R0 ;HN Point to the pseudo OP-code
MOV (R0),(R1) ;HN Temporarily restore the p-code
JSR PC,ONESTEP ;HN And execute it
MOV #XBRACE,(R1);HN And the breakpoint (p-code)
BR 11$ ;HN Continue running from the next instruction ...
5$: ADD #2,IPC(R4) ;HN Search failure case; assuming compiler generarted brkpnt
11$: CLR HALTSW ;HN Make sure Halt Switch is turned off.
EVWAIT INTEVT ;HN Enter critical section
MOV #ISTBLK,R0 ;HN Initialize the link to all ISB's
1$: MOV NXTINT(R0),R0 ;HN R0 ← NEXT ISB
BEQ 2$ ;HN No more ?
EVSIG WAKEVT(R0);HN Signal this interpreter's WAKEVT
BR 1$ ;HN Go find next one
2$: EVSIG INTEVT ;HN End of critical section
; EVWAIT WAKEVT(R4);HN ******* JUST FOR TEST ***
MOV ANPTR(R2),R0;HN Prepare to send the DONE message and leave
MOV #DONEMES,R1 ;HN
JSR PC,TACK ;HN
MOV R0,ANPTR(R2);HN
JMP SNDANS ;HN
; DOSHOW, ONESHOW, DOPUT, NUMRFY
;Argument list generator macro :
;-------------------------------
.MACRO MAKEOP CNAME, ANAME, ARGLEN ;Compiler name, Address name
TEMP=. ;HN
.=ARGTBL+II ;HN Address of an entry in the argument ID table
.IFLE TEMP-.
.ERROR ARGTBL RUNS OUT OF ITS LIMIT
.ENDC
ARGLEN ;HN Argument list length ID (an entry)
.=TEMP ;HN
II=II+2
.ENDM
;Table of argument list lengths of all op_codes (7≡ ends with a list of arguments)
; (9≡ / / / / ... PLUS TWO MORE !!)
;Used by debugging routines
DATA
ARGTBL: .BLKW 250 ;HN
;The interpreter operation table
II=0
MAKEOP XINVALID,INVALID,INVALID ;Illegal instruction
.INSRT INTARG.PAL[AL,HE]
CODE
DOSHOW:
COMMENT ⊗ Test service routine,
causes the current pseudo-code and its relative address (starting from 0)
to be shown to the requester. ⊗
MOV AGPTR(R2),R0;HN See how many pcodes the user wants to see
JSR PC,GETOCT ;HN put that number in R1
MOV CURNAM,R4 ;HN Look at the current interpreter
MOV IPC(R4),-(SP);HN Save current IPC
1$: JSR PC,ONESHOW ;HN Show one (next) pcode with its arguments (if any)
MOV R1,-(SP) ;HN Save the counter
MOV ANPTR(R2),R0;HN
MOV #CRLFMS,R1 ;HN
JSR PC,TACK ;HN
MOV R0,ANPTR(R2);HN
MOV NEWIPC,IPC(R4);HN IPC of the next pseudo instruction
MOV (SP)+,R1 ;HN Restore the counter
SOB R1,1$ ;HN Repeat above for as many times as wanted
MOV (SP)+,IPC(R4);HN Restore original IPC
JMP SNDANS ;HN
ONESHOW:
MOV R1,-(SP) ;HN Save R1 for the outer loop i.e. DOSHOW
MOV IPC(R4),-(SP);HN .. IPC
MOV ANPTR(R2),R0;HN Prepare the answer
MOV #ADRMES,R1 ;HN With "ADDRESS "
JSR PC,TACK ;HN
MOV R0,ANPTR(R2);HN Update the answer pointer
MOV IPC(R4),R0 ;HN Take the current pseudo-code address
JSR PC,NUMRFY ;HN Numerify it (R1←string ptr.)
MOV ANPTR(R2),R0;HN &
JSR PC,TACK ;HN put it to be sent ...
MOV #PCDMES,R1 ;HN "P-CODE: "
JSR PC,TACK ;HN in the answer
MOV R0,ANPTR(R2);HN Update the answer pointer
MOV @IPC(R4),R0 ;HN Take the P-Code itself
CMP R0,#XBRACE ;HN Is there a breakpoint ?
BNE 1$ ;HN No. OK go ahead.
MOV IPC(R4),R1 ;HN Yes. Prepare to ...
JSR PC,BRSRCH ;HN Find the original pcode
TST R0 ;HN Was it a compiler generated brkpnt ?
BEQ 2$ ;HN Yes. Go ahead and show it as it is
ADD #2,R0 ;HN No. Point R0 to the pcode
MOV (R0),-(SP) ;HN Push the pcode
MOV ANPTR(R2),R0;HN
MOV #ASTRSK,R1 ;HN Put a *
JSR PC,TACK ;HN before the pcode
MOV R0,ANPTR(R2);HN in the show message
MOV (SP)+,R0 ;HN POP the pcode into R0
BR 1$ ;HN and continue ...
2$: MOV #XBRACE,R0 ;HN Do this when brkpnt is not in the BRKTBL
1$: MOV R3,-(SP) ;HN Save R3
tmp1: MOV ARGTBL(R0),R3 ;HN R3 ← No. of pcode arguments
MOV R3,ARGNUM ;HN no. of args.
JSR PC,NUMRFY ;HN Numerify the P_Code
MOV ANPTR(R2),R0;HN &
JSR PC,TACK ;HN put it to be sent ...
MOV R0,ANPTR(R2);HN Update the answer pointer
TST R3 ;HN Are there any arguments ?
BEQ 3$ ;HN No. just send the opcode
;HN Yes. prepare sending the arguments in the message
4$: ADD #2,IPC(R4) ;HN Point to the first argument in the pcode
MOV #COMSPC,R1 ;HN put comma and space before the next argument
JSR PC,TACK ;HN
MOV R0,ANPTR(R2);HN
MOV @IPC(R4),R0 ;HN Take the next argument
JSR PC,NUMRFY ;HN Numerify it
MOV ANPTR(R2),R0;HN &
JSR PC,TACK ;HN And put it to be sent
CMP ARGNUM,#7 ;HN Are we dealing with a list ?
BNE 5$ ;HN No.
TST @IPC(R4) ;HN Yes. End of the list ?
BNE 4$ ;HN No. Go back and take the next arg.
BR 6$ ;HN Yes. we are almost done
5$: SOB R3,4$ ;HN Go back to 4$ if any more arg.
6$: MOV R0,ANPTR(R2);HN All done. update the ANPTR
3$: MOV (SP)+,R3 ;HN Restore R3
ADD #2,IPC(R4) ;HN Update the new IPC
MOV IPC(R4),NEWIPC ;HN Save IPC pointer now for the outer loop (if any)
MOV (SP)+,IPC(R4);HN Restore IPC
MOV (SP)+,R1 ;HN Restore R1 (for the outer loop ...)
RTS PC ;HN And return to the calling routine
DATA
ARGNUM: .WORD 0 ;HN Number of arguments of a pcode
NEWIPC: .WORD 0 ;HN To be used for multiple shows (i.e. SHOW n) by DOSHOW
CODE
DOPUT:
COMMENT ⊗ Test service routine,
PUTs the given pcode (currently acceptable only in octal form) AT the given pcode
address. ⊗
MOV AGPTR(R2),R0;HN Look at the argument string
JSR PC,GETOCT ;HN R1← numeric value of the arg.
ADD #2,R0 ;HN AT ... (any two chars. the first being non-blank ..)
MOV R1,-(SP) ;HN save the code
JSR PC,GETOCT ;HN get the address
MOV (SP)+,(R1) ;HN PUT the code AT the address.
MOV ANPTR(R2),R0;HN
MOV #DONEMES,R1 ;HN DONE
JSR PC,TACK ;HN
MOV R0,ANPTR(R2);HN
JMP SNDANS ;HN
NUMRFY:
COMMENT ⊗ R0 contains the value to be octally numerified.
Octal string will be put in a buffer and will be pointed to by R1 (with one
null char. at the right end). ⊗
MOV R3,-(SP) ;HN save R3
MOV #NUMBUF+7,R3;HN initialize the string pointer
MOVB #0,(R3) ;HN push the null char.
DEC R3 ;HN
TST R0 ;HN is the number too large (looks negative ?)
BGE 3$ ;HN No. then enter the subroutine normally
JSR PC,4$ ;HN Yes then the subroutine, passed CMP test
BR 5$ ;HN
3$: JSR PC,1$ ;HN call internal (actual) numerifier.
5$: MOV R3,R1 ;HN R1 to be the string pointer
MOV (SP)+,R3 ;HN restore R3
RTS PC ;HN and return.
1$: CMP R0,BASE ;HN Is the argument less than the base ?
BLT 2$ ;HN yes, OK then it represents the list significant digit
4$: MOV R0,R1 ;HN No, PREPARE FOR DIVISION
CLR R0 ; //
DIV BASE,R0 ;HN Divide R0 by the BASE , R1 ← remainder
BISB #60,R1 ;HN ASCIIfy the remainder digit
MOVB R1,(R3) ;HN PUSH CURRENT least significant DIGIT
DEC R3 ;HN
BR 1$ ;HN Repeat for the next digit
2$: BISB #60,R0 ;HN ASCIIfy this digit
MOVB R0,(R3) ;HN PUSH least significant DIGIT
RTS PC
DATA
BASE: .WORD 10 ;HN
NUMBUF: .BLKB 10 ;HN string buffer
CODE
; DOBREAK, DOUNBREAK, BRSRCH
DOBREAK:
COMMENT ⊗ Test service routine.
Current acceptable argument is "n". Puts a break_point (XBRACE) in PCODE address "n"
and saves current op_code (along with its address/current IPC) in the break table. ⊗
MOV #BRKTBL,R0 ;HN Check for break table overflow
ADD #2*BRSIZE,R0;HN
CMP BRKPTR,R0 ;HN
BLT 1$ ;HN OK Go set the break-point
MOV ANPTR(R2),R0;HN OVERFLOW: Just tell the user about it
MOV #OVRMES,R1 ;HN
BR 2$ ;HN
1$: MOV AGPTR(R2),R0;HN Look at the argument string
JSR PC,GETOCT ;HN R1←numeric value of the argument
JSR PC,BRSRCH ;HN See if the brkpnk already there
TST R0 ;HN
BEQ 11$ ;HN
MOV #SAMEBR,R1 ;HN If true, tell the user about it
MOV ANPTR(R2),R0;HN
BR 2$ ;HN
11$: MOV R1,@BRKPTR ;HN Add the new IPC to the BRKTBL
ADD #2,BRKPTR ;HN Update the break table pointer
MOV (R1),@BRKPTR;HN Add the pseudo opcode in this IPC to the BRKTBL
ADD #2,BRKPTR ;HN Update the break table pointer
MOV #XBRACE,(R1);HN PUT THE BREAK-POINT IN THE PSEUDO CODE
MOV ANPTR(R2),R0;HN ................
MOV #DONEMES,R1 ;HN Answer will be "DONE"
2$: JSR PC,TACK ;HN
MOV R0,ANPTR(R2);HN
JMP SNDANS ;HN Send it winging on its way ...
DOUNBREAK:
COMMENT ⊗ Test service routine.
Current acceptable argument is "n". Looks at P-CODE address "n" ; there should be
an XBRACE code there, if not nothing other than reporting of the subject to the
user occurs. If there was a break_point there, then the break(point) table gets
searched to see if the break_point was set by ALAID. If the search was successful
then the corresponding original op_code will be put back to the address "n" and
the break table gets compacted as we no longer need that entry in the table. If
the break_point had been put by the compiler, the search will probably fail in which
case the break_point will be cleared by putting an XNOOP code instead of the XBRACE
code at "n". ⊗
MOV AGPTR(R2),R0;HN Look at the argument string
JSR PC,GETOCT ;HN R1 ← numeric value of the argument
CMP (R1),#XBRACE;HN Is there a break_point there ?
BEQ 1$ ;HN Yes. Go do the job ..
MOV #NOBRKPT,R1 ;HN No. Report it to the user,
BR 7$ ;HN and leave.
1$: JSR PC,BRSRCH ;HN Search the breakpoint table
TST R0 ;HN Found ?
BEQ 5$ ;HN No.
CLR (R0)+ ;HN Yes. we found the entry. Clear the IPC field,
MOV (R0),(R1) ;HN put back the original op_code,
SUB #2,BRKPTR ;HN
MOV @BRKPTR,(R0);HN Put the last entry in the place of the previous brkpnt.
SUB #2,BRKPTR ;HN
MOV @BRKPTR,-(R0);HN
BR 6$ ;HN
5$: MOV #XNOOP,(R1) ;HN Search has failed, just put NOOP at "n"
;HN (It probably has been put by the compiler.)
6$: MOV #DONEMES,R1 ;HN Job is "DONE" ... let the user know
7$: MOV ANPTR(R2),R0;HN ....
JSR PC,TACK ;HN ....
MOV R0,ANPTR(R2);HN ....
JMP SNDANS ;HN ... And leave ...
BRSRCH:
Comment ⊗ Assuming R1=<pcode address>, this subroutine searches (linearly) the break
point table to find an entry with the same address field. R0 gets the found
address unless search fails in which case R0←0 .
⊗
1$: MOV #BRKTBL,R0 ;HN Initialize the table searching pointer
2$: CMP R0,BRKPTR ;HN
BGE 4$ ;HN Are we out of the table ?
CMP (R0),R1 ;HN No. Is this entry what we are looking for ?
BNE 3$ ;HN
RTS PC ;HN Yes. Return (R0 correct)
3$: ADD #4,R0 ;HN No. then go look at the next one.
BR 2$ ;HN
4$: CLR R0 ;HN Search failed: R0←0
RTS PC ;HN Return
BRSIZE = 100 ;HN Size of the break_table
DATA
BRKPTR: .WORD BRKTBL ;HN Break table pointer
BRKTBL: .BLKW BRSIZE ;HN Break table itself.
CODE
; DOJUMP, DOSTEP, ONESTEP
DOJUMP:
COMMENT ⊗ Test service routine.
Current acceptable argument is "n". Causes the current interpreter's IPC take the
value "n", as if it had executed an XJUMP code. ⊗
TST HALTSW ;HN Are interpreters in the HALT state ?
BNE 1$ ;HN Yes. OK go do the job.
MOV #SETHLT,R1 ;HN No. Then ask user to put them in that state
MOV ANPTR(R2),R0;HN
JSR PC,TACK ;HN
MOV R0,ANPTR(R2);HN
JMP SNDANS ;HN And leave ..
1$: MOV AGPTR(R2),R0;HN Look at "n"
JSR PC,GETOCT ;HN Take its value in R1
MOV CURNAM,R4 ;HN And the current interpreter in R4
MOV R1,IPC(R4) ;HN Actual jump !!
JMP DOGO ;HN And GO ...
DOSTEP:
COMMENT ⊗ Test service routine.
Causes the pseudo_code at current IPC of the current interpreter (pointed to by
CURNAM) to be executed. IPC will be updated accordingly.
This command takes no argument. ⊗
TST HALTSW ;HN Are interpreters in the HALT state ?
BNE 1$ ;HN Yes. OK go do the job.
MOV #SETHLT,R1 ;HN No. Then ask user to put them in that state
MOV ANPTR(R2),R0;HN
JSR PC,TACK ;HN
MOV R0,ANPTR(R2);HN
JMP SNDANS ;HN And leave ..
1$: MOV AGPTR(R2),R0;HN See how many steps the user wants to execute
JSR PC,GETOCT ;HN put that number in R1
2$: MOV R1,-(SP) ;HN Save the counter
MOV CURNAM,R4 ;HN Take the current interpreter
MOV IPC(R4),R1 ;HN and R1 to the current IPC
CMP (R1),#XBRACE;HN Is there a breakpoint at the current instruction
BNE 9$ ;HN No. OK proceed normally
JSR PC,BRSRCH ;HN Yes, there is a preakpoint there; search the brkpnt tbl.
TST R0 ;HN Search successful ?
BEQ 8$ ;HN No. Assume a compiler initiated breakpoint
ADD #2,R0 ;HN Yes. Point R0 to the pseudo OPcode
MOV (R0),(R1) ;HN And replace the XBRACE by that
JSR PC,ONESTEP ;HN Execute the pseudo instruction
MOV #XBRACE,(R1);HN Restore the breakpoint
BR 10$ ;HN Report
8$: ADD #2,IPC(R4) ;HN Pass the cmplr. init. brkpnt.
9$: JSR PC,ONESTEP ;HN Execute one pseudo instruction
10$: MOV (SP)+,R1 ;HN Restore the counter
SOB R1,2$ ;HN Repeat above for as many times as wanted
JSR PC,ONESHOW ;HN and SHOW the state of the world ..
JMP SNDANS ;HN
ONESTEP:
COMMENT ⊗ While HALTSW=1, calling this subroutine causes ONE pseudo instruction
to be executed.
⊗
MOV #ALDSS,DEBMOD(R4) ;HN Set the DEBugging MOde to Single Step
EVSIG WAKEVT(R4);HN Allow one pseudo-instruction to be executed
EVWAIT STPEVT(R4);HN Done ?
CLR DEBMOD(R4) ;HN Yes. Reset the DEBug MOde
RTS PC ;HN And return
; Driver for test of communications, ALINIT, ALKILL
.IFNZ DEBUG
temp == %OFFSE ;Save the current offset
.OFFSET 0 ;We want to use real physical addresses here for the kernel
PUTLOC JOBDAT, MAINBL
PUTLOC JOBSA, START
PUTLOC JOBDM, USRDM
.OFFSET temp ;Restore Offset
DATA
MAINBL: PDBLK 1,200,S ;Makes a process descriptor for main process
CODE
START: JSR PC,IOINIT ;
JSR PC,FRINIT ;
CLR NOTB10
CLR NOTB11
EVMAK ;Create and signal once the AL interlock event.
MOV (SP),ALDEVT ;
EVSIG ;
CLR WAITQ+QNEXT ;
JMP SERVER ;No, he'll never return
GETARG: MOV R0,FAKE ;
MOV #FAKE1,R0 ;
RTS PC
DATA
FAKE: .BLKW 2 ;Long enough for floating
FAKE1: FAKE
CODE
ROUTINE GETVAL,<GTV.ARG>
MOV GTV.ARG(RF),R0
RTS PC
ROUTINE CHANGE,<CHG.ND,CHG.VN>
RTS PC
GETSCA: MOV #FAKE,R0 ;
MOV R0,-(R3) ;
RTS PC ;
GETTRN: MOV #60,R0 ;
JSR PC,GTFREE ;
MOV R0,-(R3) ;
TACKVAL:
COMMENT ⊗ R1 = LOC[value], R0 ← where to put it ⊗
MOV #FAKEMES,R1 ;
JMP TACK ;
DATA
FAKEMES:ASCIE </999.999/>
CODE
.ENDC
DATA
ALPDB: PDBLK 2,150,S ;Makes a process descriptor for server
CODE
ALINIT:
COMMENT ⊗ Start up one copy of the server as a separate job. ⊗
EVMAK ;Create and signal once the AL interlock event.
MOV (SP),ALDEVT
EVSIG
CLR WAITQ+QNEXT
CLR NOTB11
CLR NOTB10
MOV #1,ALLIVE ;Indicate that the AL interpreter is alive
MOV #20,R0 ;R3 stack space
JSR PC,GTFREE
ADD #40,R0 ;to end of space
MOV #ALPDB,R1 ;R1 ← LOC[ALAID process descriptor]
BIS #UGRSAV+USKSAV,PDBSTA(R1) ;Use saved registers.
MOV R0,PDBR3(R1) ;Store away the R3 stack pointer.
MOV USKMAX(R1),USKP(R1) ;Make sure we have a good stack pointer
SCHEDU R1,#SERVER,#USRDM,#2 ;Cause the new process to be started, suspended
RTS PC
ALKILL: CLR ALLIVE ;Indicate that the AL interpreter is dead
RTS PC
; BUGS
COMMENT ⊗
DOSTART calls SPAWN, which expects R4 to point to a valid ISB. This
is not always possible, so either SPAWN should be changed, or, more
likely, a special version of SPAWN should be used that sets up an ISB
from scratch, much as is done in AL(3P).
⊗